home *** CD-ROM | disk | FTP | other *** search
/ Varios Español / Varios Español.iso / DBASE5 / CUA_SAMP.ZIP / GESTION.PRG < prev    next >
Text File  |  1994-10-12  |  22KB  |  693 lines
  1. ******************************************************************************
  2. * PROGRAM NAME: BUSINESS.PRG
  3. *
  4. *               SAMPLE CUA BUSINESS APPLICATION SYSTEM
  5. * LAST CHANGED: 06/20/94 08:00AM
  6. * WRITTEN BY:   Borland International Inc.
  7. *
  8. ******************************************************************************
  9. PROCEDURE GESTION
  10.     _cmdWindow.visible = .F.  && Get rid of command window
  11.     SET TALK OFF
  12.     CLEAR ALL                   && Close open files and clear memvars
  13.     SET STATUS OFF
  14.     SET LIBRARY TO (HOME() + "FORMRUN.DBO")
  15.     DEFINE FORM dB5___XXX PROPERTY VISIBLE .F.   && create an object
  16.     lVoid = dB5___XXX.Open()                     && reference variable
  17.     _CmdWindow.oDesk = dB5___XXX.Parent          && to point to _Desktop
  18.     lVoid = dB5___XXX.Close()                    && and store it in
  19.     lVoid = dB5___XXX.Release()                  && _CmdWindow
  20.     RELEASE dB5___XXX
  21.     *
  22.     * Define the Menu Object as the Top most object and Open
  23.     *
  24.     DEFINE MENUBAR Main
  25.     DEFINE MENU F1 OF Main ;
  26.         PROPERTY ;
  27.             Text "&Fichero"
  28.     *
  29.     * Define Menu Items under the FILE Option
  30.     *
  31.     DEFINE MENUITEM Open OF Main.F1 ;
  32.         PROPERTY ;
  33.             Text "&Abrir",;
  34.             StatusMessage "Browse de la base de datos (SOLO LECTURA)",;
  35.             OnClick OpenFile
  36.     DEFINE MENUITEM CloseAll OF Main.F1 ;
  37.         PROPERTY ;
  38.             Text "&Cerrar todos" ,;
  39.             StatusMessage "Cerrar todas las bases de datos abiertas",;
  40.             OnClick CloseAll
  41.     DEFINE MENUITEM Sep1 OF Main.F1 ;
  42.         PROPERTY ;
  43.             Separator .T.
  44.     DEFINE MENUITEM Bac OF Main.F1 ;
  45.         PROPERTY ;
  46.             Text "Copiar/&Recuperar",;
  47.             OnClick "Copiaseg" ,;
  48.             ProcFile "Copiaseg.prg"
  49.     DEFINE MENUITEM Sep2 OF Main.F1 ;
  50.         PROPERTY ;
  51.             Separator .T.
  52.     DEFINE MENUITEM Edbase OF Main.F1 ;
  53.         PROPERTY ;
  54.             Text "&Salir a dBASE",;
  55.             SHORTCUT "ALT-F4",;
  56.             StatusMessage "Salir a la ventana de mandatos de dBASE",;
  57.             OnClick cl_bus
  58.     DEFINE MENUITEM Exit OF Main.F1 ;
  59.         PROPERTY ;
  60.             Text "Salir al &DOS",;
  61.             StatusMessage "Salir de Gestión y volver al DOS",;
  62.             OnClick Leave
  63.     *
  64.     * Define the second CUA Option EDIT
  65.     *
  66.     DEFINE MENU E OF Main ;
  67.         PROPERTY ;
  68.             Text "&Edición"
  69.     *
  70.     * Define Menu Items under the EDIT Option
  71.     *
  72.     DEFINE MENUITEM Undo OF Main.E ;
  73.         PROPERTY ;
  74.             TEXT "&Deshacer",;
  75.             Enabled .F.,;
  76.             SHORTCUT "ALT-BACKSPACE",;
  77.             StatusMessage "Cancelar la última modificación del registro",;
  78.             OnClick UndoIt
  79.     DEFINE MENUITEM Save OF Main.E ;
  80.         PROPERTY ;
  81.             TEXT "&Almacenar",;
  82.             Enabled .F.,;
  83.             StatusMessage "Almacenar las modificaciones del registro actual",;
  84.             OnClick SubmitIt
  85.     DEFINE MENUITEM Sep1 OF Main.E ;
  86.         PROPERTY ;
  87.             Separator .T.
  88.     DEFINE MENUITEM Copy Of Main.E ;
  89.         PROPERTY ;
  90.             Text "&Copiar",;
  91.             SHORTCUT "CTRL-INS",;
  92.             StatusMessage "Opción no implementada",;
  93.             OnClick Devnote
  94.     DEFINE MENUITEM Paste OF Main.E ;
  95.         PROPERTY ;
  96.             Text "&Pegar",;
  97.             SHORTCUT "SHIFT-INS",;
  98.             StatusMessage "Opción no implementada",;
  99.             OnClick Devnote
  100.     *
  101.     * Define the fourth CUA item Table
  102.     *
  103.     DEFINE MENU S OF Main ;
  104.         PROPERTY ;
  105.             Text "&Tabla",;
  106.             OnClick "CheckOpen"
  107.     DEFINE MENUITEM Srch OF Main.S;
  108.         PROPERTY ;
  109.             Text "&Buscar",;
  110.             Enabled .F. ,;
  111.             StatusMessage "Buscar registros (basado en la ficha actualmente abierta)",;
  112.             OnClick "Srchr"
  113.     DEFINE MENUITEM Sep1 OF Main.S ;
  114.         PROPERTY ;
  115.             Separator .T.
  116.     DEFINE MENUITEM tp OF Main.S ;
  117.         PROPERTY ;
  118.             Text "&Principio",;
  119.             Enabled .F. ,;
  120.             StatusMessage "Ir al primer registro de la tabla",;
  121.             OnClick "GoTop"
  122.     DEFINE MENUITEM btm OF Main.S ;
  123.         PROPERTY ;
  124.             Text "&Final",;
  125.             Enabled .F. ,;
  126.             StatusMessage "Ir al último registro de la tabla",;
  127.             OnClick "GoBott"
  128.     DEFINE MENUITEM Sep2 OF Main.S ;
  129.         PROPERTY ;
  130.             Separator .T.
  131.     DEFINE MENUITEM pck OF Main.S ;
  132.         PROPERTY ;
  133.             Text "&Eliminar borrados",;
  134.             StatusMessage "Eliminar todos los registros marcados para borrado en todas las tablas",;
  135.             OnClick "PackTabl"
  136.     DEFINE MENUITEM Indx OF Main.S ;
  137.         PROPERTY ;
  138.             TEXT "&Reindexar",;
  139.             StatusMessage "Reindexar todas las tablas",;
  140.             OnClick "inddbf"
  141.     *
  142.     * Define the fifth CUA item Application
  143.     *
  144.     DEFINE MENU App OF Main PROPERTY Text "&Aplicación"
  145.     DEFINE MENUITEM cust OF Main.App ;
  146.         PROPERTY ;
  147.             Text "&Clientes",;
  148.             OnClick Cust,;
  149.             ProcFile "CLI.prg"
  150.     DEFINE MENUITEM Ord OF Main.App ;
  151.         PROPERTY ;
  152.             Text "&Pedidos",;
  153.             OnClick Orders,;
  154.             ProcFile "PEDIDOS.prg"
  155.     DEFINE MENUITEM Sep1 OF Main.App ;
  156.         PROPERTY ;
  157.             Separator .T.
  158.     DEFINE MENUITEM Vend OF Main.App ;
  159.         PROPERTY ;
  160.             Text "P&roveedores",;
  161.             OnClick Vendors,;
  162.             ProcFile "PROVEEDS.prg"
  163.     DEFINE MENUITEM Gds OF Main.App ;
  164.         PROPERTY ;
  165.             Text "&Artículos",;
  166.             OnClick Goods,;
  167.             ProcFile "ARTICULO.prg"
  168.     DEFINE MENUITEM Sep2 OF Main.App ;
  169.         PROPERTY ;
  170.             Separator .T.
  171.     DEFINE MENUITEM Acc OF Main.App ;
  172.         PROPERTY ;
  173.             Text "&Movimiento de cuentas",;
  174.             OnClick "Acct_rec" ,;
  175.             Procfile "MOV_CTAS.prg"
  176.     DEFINE MENUITEM Inv OF Main.App ;
  177.         PROPERTY ;
  178.             Text "&Imprimir facturas",;
  179.             Onclick "Facturas",;
  180.             ProcFile "Facturas.prg"
  181.     DEFINE MENUITEM Sep3 OF Main.App ;
  182.         PROPERTY ;
  183.             Separator .T.
  184.     DEFINE MENUITEM emp OF Main.App ;
  185.         PROPERTY ;
  186.             Text "&Empleados",;
  187.             OnClick Employee,;
  188.             ProcFile "EMPLEADO.prg"
  189.     DEFINE MENUITEM Are OF Main.App;
  190.         PROPERTY ;
  191.             Text "Pre&fijos",;
  192.             OnClick "AreaCode",;
  193.             ProcFile "PREFIJOS.prg"
  194.     *
  195.     * Define the sixth CUA item HELP
  196.     *
  197.     DEFINE MENU H OF Main ;
  198.         PROPERTY ;
  199.             Text "A&yuda"
  200.     DEFINE MENUITEM keyb OF Main.H ;
  201.         PROPERTY ;
  202.             Text "&Teclado",;
  203.             OnClick DevNote1
  204.     DEFINE MENUITEM Indx OF Main.H ;
  205.         PROPERTY ;
  206.             Text "&Indice",;
  207.             OnClick DevNote1
  208.     DEFINE MENUITEM Abt OF Main.H ;
  209.         PROPERTY ;
  210.             Text "&Acerca de",;
  211.             OnClick "About"
  212.     * Define the FORM for HELP|ABOUT
  213.     DEFINE FORM Abt_box FROM 1,3 TO 18,73 ;
  214.         PROPERTY ;
  215.             Text "Acerca de la aplicación Gestión",;
  216.             Sizeable .F.
  217.     * Define the text to go in the form for HELP|ABOUT
  218.     DEFINE TEXT T1_abt OF Abt_box AT 1,2 ;
  219.         PROPERTY ;
  220.             TEXT "Esta versión de GESTION está escrita específicamente para dBASE"
  221.     DEFINE TEXT T2_abt OF Abt_box AT 2,2 ;
  222.         PROPERTY ;
  223.             TEXT "DOS versión 5.0, conocida originalmente como A-T INDUSTRIAS DEL"
  224.     DEFINE TEXT T3_abt OF Abt_box AT 3,2 ;
  225.         PROPERTY ;
  226.             TEXT "MUEBLE. Se ha creado esta nueva versión para demostrar el nuevo"
  227.     DEFINE TEXT T4_abt OF Abt_box AT 4,2 ;
  228.         PROPERTY ;
  229.             TEXT "modelo de control de sucesos y de objetos de dBASE 5.0 para DOS."
  230.     DEFINE TEXT T5_abt OF Abt_box AT 6,2 ;
  231.         PROPERTY ;
  232.             TEXT "El módulo principal es GESTION.PRG que llama a cada subrutina   "
  233.     DEFINE TEXT T6_abt OF Abt_box AT 7,2 ;
  234.         PROPERTY ;
  235.             TEXT "después de cada tabla (ej. EMPLEADO, PROVEEDS, etc).   Cada     "
  236.     DEFINE TEXT T7_abt OF Abt_box AT 8,2 ;
  237.         PROPERTY ;
  238.             TEXT "subrutina tiene un .DFM  (código fuente de ficha) asociado."
  239.     DEFINE TEXT T8_abt OF Abt_box AT 10,2 ;
  240.         PROPERTY ;
  241.             TEXT "El estudio del código fuente (en <u>:\<dirdbase>\CUA_EJEM), "
  242.     DEFINE TEXT T9_abt OF Abt_box AT 11,2 ;
  243.         PROPERTY ;
  244.             TEXT "junto con la documentación del producto, le ayudará a conocer"
  245.     DEFINE TEXT T10_abt OF Abt_box AT 12,2 ;
  246.         PROPERTY ;
  247.             TEXT "las nuevas y potentes características del lenguaje dBASE.",;
  248.             LABEL .F.
  249.     * Define the PushButton for closing the form Abt_box
  250.     DEFINE PUSH okab OF Abt_box AT 14,28 ;
  251.         PROPERTY ;
  252.             TEXT "Aceptar",;
  253.             WIDTH 11,;
  254.             DEFAULT .T.,;
  255.             OnClick CloseAbt
  256.     CLEAR
  257.     *
  258.     * Open the Menu Object as the top most object
  259.     *
  260.     lVoid = Main.open()
  261.     DO About
  262. RETURN
  263. ****************************
  264. PROCEDURE Inddbf                              && Indexing tables
  265.     IF LEN(DBF()) > 0                          && There is a table open
  266.         DO ErrorMsg WITH "Para ejecutar este procedimiento deberá salir de todas las fichas .."
  267.     ELSE
  268.         DO Gauge
  269.         Status.Gauge.WIDTH = 5
  270.         Status.T3.Text = "Empleados ..."
  271.         USE EMPLEADO EXCL
  272.         REINDEX
  273.         Status.Gauge.WIDTH = 10
  274.         Status.T3.Text = "Proveedores ... "
  275.         USE PROVEEDS EXCL
  276.         REINDEX
  277.         Status.Gauge.WIDTH = 15
  278.         Status.T3.Text = "Artículos ...   "
  279.         USE ARTICULO EXCL
  280.         REINDEX
  281.         Status.Gauge.WIDTH = 20
  282.         Status.T3.Text = "Clientes ..."
  283.         USE CLI EXCL
  284.         REINDEX
  285.         Status.Gauge.WIDTH = 25
  286.         Status.T3.Text = "Pedidos ...  "
  287.         USE PEDIDOS EXCL
  288.         REINDEX
  289.         Status.Gauge.WIDTH = 30
  290.         Status.T3.Text = "Movimiento de cuentas ..."
  291.         USE MOV_CTAS EXCL
  292.         REINDEX
  293.         Status.Gauge.WIDTH = 35
  294.         Status.T3.Text = "Prefijos..."
  295.         USE PREFIJOS EXCL
  296.         REINDEX
  297.         USE
  298.         CLEA
  299.         lVoid = Status.Release()
  300.     ENDIF
  301. RETURN
  302. ****************************
  303. PROCEDURE PackTabl                         && Packing Tables
  304.     CLOSE ALL
  305.     DO Gauge
  306.     * Check to see if there are any tables open
  307.     IF LEN(DBF()) > 0
  308.         DO ErrorMsg WITH "Para ejecutar este procedimiento deberá salir de todas las fichas .."
  309.     ELSE
  310.         Status.Gauge.WIDTH = 5
  311.         Status.T3.Text = "Empleados ..."
  312.         USE EMPLEADO EXCL
  313.         PACK
  314.         Status.Gauge.WIDTH = 10
  315.         Status.T3.Text = "Proveedores ... "
  316.         USE PROVEEDS EXCL
  317.         PACK
  318.         Status.Gauge.WIDTH = 15
  319.         Status.T3.Text = "Artículos ...   "
  320.         USE ARTICULO EXCL
  321.         PACK
  322.         Status.Gauge.WIDTH = 20
  323.         Status.T3.Text = "Clientes ..."
  324.         USE CLI EXCL
  325.         PACK
  326.         Status.Gauge.WIDTH = 25
  327.         Status.T3.Text = "Pedidos ...  "
  328.         USE PEDIDOS EXCL
  329.         PACK
  330.         Status.Gauge.WIDTH = 30
  331.         Status.T3.Text = "Movimiento de cuentas ..."
  332.         USE MOV_CTAS EXCL
  333.         PACK
  334.         USE
  335.         Status.Gauge.Width = 35
  336.         Status.T3.Text = "Prefijos ..."
  337.         USE PREFIJOS EXCL
  338.         PACK
  339.         USE
  340.         CLEA
  341.         lVoid = Status.Release()
  342.     ENDIF
  343.     RETURN
  344. ****************************
  345. PROCEDURE Gauge
  346.     DEFINE FORM Status FROM 5,25 TO 10,65 ;
  347.         PROPERTY ;
  348.             Text "Estado" ,;
  349.             COLORNORMAL "W/B"
  350.     DEFINE TEXT t1 OF Status AT 0,1 ;
  351.         PROPERTY ;
  352.             TEXT "0%",;
  353.             COLORNORMAL "B/W"
  354.     DEFINE TEXT t2 OF Status AT 0,34 ;
  355.         PROPERTY ;
  356.             Text "100%",;
  357.             COLORNORMAL "B/W"
  358.     DEFINE TEXT t3 OF Status AT 3,1 ;
  359.         PROPERTY ;
  360.             Text "",;
  361.             COLORNORMAL "B/W"
  362.     DEFINE RECTANGLE Gauge OF Status AT 4,1  ;
  363.         PROPERTY ;
  364.             TOP 1,;
  365.             LEFT 1,;
  366.             HEIGHT 2,;
  367.             Width 1,;
  368.             COLORNORMAL "R/W"
  369.     lVoid = Status.Open()
  370.     RETURN
  371. ****************************
  372. PROCEDURE GOTOP                      && Going to top record in table
  373.     * Need to see if a form is on the desktop
  374.     * Use the _Clipboard reference (its always alive)
  375.     CurrObj = _ClipBoard.Parent.ActiveControl()
  376.     * Check to see if there is a form on the desktop
  377.     IF TYPE("CurrObj") = "L"
  378.         DO ErrorMsg WITH "Para ir al principio debe estar abierta una ficha ..."
  379.     ELSE
  380.        IF CurrObj.ClassName = "FORM"
  381.           lVoid = CurrObj.Submit()        && Check if Form before Submit()
  382.        ENDIF
  383.        GO TOP
  384.        IF CurrObj.ClassName = "FORM"       && Check if Form before Refresh()
  385.           lVoid = CurrObj.Refresh()
  386.        ENDIF
  387.     ENDIF
  388.     RETURN
  389. ****************************
  390. PROCEDURE GOBOTT                  && Going to Bottom Record in table
  391.     * Need to see if a form is on the desktop
  392.     * Use the _Clipboard reference (its always alive)
  393.     CurrObj = _ClipBoard.Parent.ActiveControl()
  394.     * Check to see if there is a Form on the desktop
  395.     IF TYPE("CurrObj") = "L"
  396.         DO ErrorMsg WITH "Para ir al final debe estar abierta una ficha ..."
  397.     ELSE
  398.     IF CurrObj.ClassName = "FORM"       && Check if Form before Submit()
  399.         lVoid = CurrObj.Submit()
  400.     ENDIF
  401.     GO BOTTOM
  402.     IF CurrObj.ClassName = "FORM"       && Check if Form before Refresh()
  403.         lVoid = CurrObj.Refresh()
  404.     ENDIF
  405.     IF CurrObj.ClassName = "BROWSE"     && If Browse, RefreshRecord()
  406.         lVoid = CurrObj.RefreshRecord()
  407.     ENDIF
  408.     ENDIF
  409.     RETURN
  410. ****************************
  411. PROCEDURE SubmitIt             && Writing Record info to dis
  412.     * Need to see if a form is on the desktop
  413.     * Use the _Clipboard reference (its always alive)
  414.     CurrObj = _ClipBoard.Parent.ActiveControl()
  415.     * check to see if a form is active
  416.     IF TYPE("CurrObj.ClassName") = "C"
  417.         IF CurrObj.ClassName = "FORM"
  418.             lVoid = CurrObj.Submit()
  419.         ELSE
  420.             DO ErrorMsg WITH "Para almacenar debe estar abierta una ficha ..."
  421.         ENDIF
  422.     ELSE
  423.         DO ErrorMsg WITH "Para almacenar debe estar abierta una ficha ..."
  424.     ENDIF
  425. RETURN
  426. ***************************
  427. PROCEDURE UndoIt
  428.     * Need to see if a form is on the desktop
  429.     * Use the _Clipboard reference (its always alive)
  430.     CurrObj = _ClipBoard.Parent.ActiveControl()
  431.     * check to see if a form is active, if no form on the desktop
  432.     * the type of Currobj is logical .F.
  433.     IF TYPE("CurrObj") = "L"
  434.         DO ErrorMsg WITH "Para deshacer debe estar abierta una ficha ..."
  435.     ELSE
  436.         lVoid = CurrObj.Refresh()
  437.     ENDIF
  438.     RETURN
  439. ***************************
  440. PROCEDURE AddBrowse
  441.     IF LEN(DBF()) > 0
  442.        DEFINE BROWSE brwse ;
  443.             PROPERTY ;
  444.                 APPEND   .F.,;
  445.                 MODIFY   .F.,;
  446.                 MOVEABLE .T.,;
  447.                 SIZEABLE .T.,;
  448.                 OnClose MnuEnable
  449.        lVoid = brwse.Open()
  450.     ELSE
  451.         DO ErrorMsg WITH "Es necesario tener activa una ficha o una tabla..."
  452.     ENDIF
  453. ****************************
  454. PROCEDURE AddForm
  455.     IF LEN(DBF()) > 0
  456.         STORE SUBSTR(DBF(),3) TO Fname
  457.         DO CASE
  458.             CASE SUBSTR(DBF(),3)="EMPLEADO.DBF"
  459.                 DO EMPLOYEE
  460.             CASE SUBSTR(DBF(),3)="PROVEEDS.DBF"
  461.                 DO VENDORS
  462.             CASE SUBSTR(DBF(),3)="ARTICULO.DBF"
  463.                 DO GOODS
  464.             CASE SUBSTR(DBF(),3)="CLI.DBF"
  465.                 DO CUST
  466.             CASE SUBSTR(DBF(),3)="MOV_CTAS.DBF"
  467.                 DO ACCT_REC
  468.             CASE SUBSTR(DBF(),3)="PREFIJOS.DBF"
  469.                 DO AREACODE
  470.             OTHERWISE
  471.                 DO ErrorMsg WITH "No existe ficha para "+Fname
  472.         ENDCASE
  473.     ENDIF
  474.     RETURN
  475. ****************************
  476. PROCEDURE Srchr
  477.     PRIVATE lVoid
  478.     DO MDIDXKEY
  479.     lVoid = _CmdWindow.oBForm.Refresh()
  480. RETURN
  481. ******************************
  482. PROCEDURE LEAVE
  483.     CLOSE ALL
  484.     RELEASE ALL
  485.     QUIT
  486. RETURN
  487. ******************************
  488. PROCEDURE Cl_Bus
  489.     PRIVATE oRef, oRefP, lVoid
  490.     * close any open forms
  491.     _CmdWindow.Visible = .T.
  492.     oRef  = _CmdWindow.Before
  493.     oRefP = _CmdWindow
  494.     DO WHILE oRef # _CmdWindow
  495.         IF oRef.ClassName = "FORM"
  496.             lVoid = oRef.Close()
  497.             IF TYPE("oRef.ClassName") = "C"
  498.                 lVoid = oRef.Release()
  499.             ENDIF
  500.             oRef = oRefP.Before
  501.         ELSE
  502.             oRefP = oRef
  503.             oRef  = oRefP.Before
  504.         ENDIF
  505.     ENDDO
  506.     IF TYPE("Main.ClassName") = "C"
  507.         lVoid = Main.Close()
  508.         lVoid = Main.Release()
  509.     ENDIF
  510.     CLEAR ALL
  511.     SET STATUS ON
  512.     RETURN
  513. ******************************
  514. PROCEDURE Devnote
  515.     DO NoteMsg WITH "Añada aquí el código necesario para implementar las " ;
  516.       + "opciones de menú EDICION|COPIAR y EDICION|PEGAR."
  517.     RETURN
  518. *******************************
  519. PROCEDURE Devnote1
  520.     DO NoteMsg WITH "Añada aquí el código necesario para implementar las " ;
  521.       + "opciones de menú AYUDA|TECLADO y AYUDA|INDICE."
  522.     RETURN
  523. *******************************
  524. PROCEDURE About
  525.     Lvoid=Abt_box.readmodal()
  526.     RETURN
  527. *******************************
  528. PROCEDURE CloseAbt
  529.     Lvoid=Abt_box.CLOSE()
  530.     RETURN
  531. *******************************
  532. PROCEDURE CloseAll
  533.     PRIVATE oRef, oRefP, lVoid
  534.     * close any open forms
  535.     oRef  = _CmdWindow.Before
  536.     oRefP = _CmdWindow
  537.     DO WHILE oRef # _CmdWindow
  538.         IF oRef.ClassName = "FORM"
  539.             lVoid = oRef.Close()
  540.             IF TYPE("oRef.ClassName") = "C"
  541.                 lVoid = oRef.Release()
  542.             ENDIF
  543.             oRef = oRefP.Before
  544.         ELSE
  545.             oRefP = oRef
  546.             oRef  = oRefP.Before
  547.         ENDIF
  548.     ENDDO
  549.     CLOSE ALL
  550.     RETURN
  551. *******************************
  552. PROCEDURE OpenFile
  553.     DEFINE FORM OpenFile;
  554.         PROPERTY;
  555.             AUTOSIZE    .F.,;
  556.             HEIGHT      15,;
  557.             LEFT        8,;
  558.             MDI         .T.,;
  559.             MOVEABLE    .T.,;
  560.             SIZEABLE    .F.,;
  561.             SYSMENU     .T.,;
  562.             TEXT        "Abrir fichero",;
  563.             TOP         1,;
  564.             WIDTH       45
  565.     DEFINE TEXT T1 OF OpenFile AT 2,2 ;
  566.         PROPERTY ;
  567.             TEXT "Lista de tablas :", ;
  568.             COLORNORMAL "R/W"
  569.     DEFINE LISTBOX DbfList OF OpenFile;
  570.         PROPERTY;
  571.             HEIGHT      7,;
  572.             LEFT        2,;
  573.             TOP         4,;
  574.             DataSource  "FILEMASK *.dbf",;
  575.             WIDTH       20
  576.     DEFINE CHECKBOX Excl OF OpenFile AT 10,25 ;
  577.         PROPERTY ;
  578.             Text "&Exclusivo"  ,;
  579.             COLORNORMAL "N/W" ,;
  580.             WIDTH 15
  581.     DEFINE PUSHBUTTON pbName11 OF OpenFile;
  582.         PROPERTY;
  583.             HEIGHT 2,;
  584.             LEFT 25,;
  585.             TEXT [Aceptar],;
  586.             TOP 4,;
  587.             WIDTH 11, ;
  588.             OnClick     OpenIt, ;
  589.             Default     .T.
  590.     DEFINE PUSHBUTTON pbName12 OF OpenFile;
  591.         PROPERTY;
  592.             HEIGHT      2,;
  593.             LEFT        25,;
  594.             TEXT        [Cancelar],;
  595.             TOP         7,;
  596.             WIDTH       12, ;
  597.             OnClick     CanHand
  598.     OpenFile.pbName12.PROCFILE = "CanHand.prg"
  599.     lVoid = OpenFile.Open()
  600. ******************************
  601. PROCEDURE OpenIt
  602.     FileName = OpenFile.DbfList.Value
  603.     IF OpenFile.Excl.Value
  604.         IF FileName="PREFIJOS.DBF"
  605.             USE PREFIJOS ORDER CIUDAD ALIAS PREFIJOS EXCL
  606.         ELSE
  607.            USE &FileName EXCL
  608.         ENDIF
  609.     ELSE
  610.         IF Filename="PREFIJOS.DBF"
  611.             USE PREFIJOS ORDER CIUDAD ALIAS PREFIJOS AGAIN
  612.          ELSE
  613.             USE &FileName
  614.         ENDIF
  615.     ENDIF
  616.     lVoid = OpenFile.Release()
  617.     DO AddBrowse
  618.     Main.F1.Open.Enabled=.F.
  619.     Main.S.Tp.Enabled=.T.
  620.     Main.S.Btm.Enabled=.T.
  621.     Main.E.Undo.Enabled=.F.
  622.     Main.E.Save.Enabled=.F.
  623.     Main.App.Cust.Enabled=.F.
  624.     Main.App.Inv.Enabled=.F.
  625.     Main.App.Are.Enabled=.F.
  626.     Main.App.Emp.Enabled=.F.
  627.     Main.App.Gds.Enabled=.F.
  628.     Main.App.Ord.Enabled=.F.
  629.     Main.App.Vend.Enabled=.F.
  630.     Main.App.Acc.Enabled=.F.
  631. RETURN
  632. *******************************
  633. PROCEDURE MnuEnable
  634.     CLOSE DATABASES
  635.     IF TYPE("Main.ClassName") = "C"
  636.         Main.S.Srch.Enabled=.F.
  637.         Main.S.Tp.Enabled=.F.
  638.         Main.S.Btm.Enabled=.F.
  639.         Main.E.Undo.Enabled=.F.
  640.         Main.E.Save.Enabled=.F.
  641.         Main.App.Cust.Enabled=.T.
  642.         Main.App.Inv.Enabled=.T.
  643.         Main.App.Are.Enabled=.T.
  644.         Main.App.Emp.Enabled=.T.
  645.         Main.App.Gds.Enabled=.T.
  646.         Main.App.Ord.Enabled=.T.
  647.         Main.App.Vend.Enabled=.T.
  648.         Main.App.Acc.Enabled=.T.
  649.         Main.F1.Open.Enabled=.T.
  650.         Main.S.Pck.Enabled=.T.
  651.         Main.S.Indx.Enabled=.T.
  652.     ENDIF
  653.     lVoid=Brwse.Release()
  654. RETURN
  655. *******************************
  656. PROCEDURE CheckOpen
  657.     IF ChkOpen()
  658.         Main.S.pck.Enabled  = .F.
  659.         Main.S.Indx.Enabled = .F.
  660.     ELSE
  661.         Main.S.pck.Enabled  = .T.
  662.         Main.S.Indx.Enabled = .T.
  663.     ENDIF
  664.     IF ISBLANK(ORDER()) .OR. TYPE("BRWSE.PARENT")="O"
  665.         Main.S.Srch.Enabled = .F.
  666.     ELSE
  667.         Main.S.Srch.Enabled = .T.
  668.     ENDIF
  669. RETURN
  670. *******************************
  671. FUNCTION ChkOpen
  672.     PRIVATE nWA, lRet, nOld
  673.     SET TALK OFF
  674.     IF .NOT. ISBLANK(ALIAS())
  675.         nOld = SELECT(ALIAS())
  676.     ELSE
  677.         nOld = SELECT()
  678.     ENDIF
  679.     lRet = .F.
  680.     FOR nWA = 1 TO 40
  681.         SELECT (nWA)
  682.         IF .NOT. ISBLANK(DBF())
  683.             lRet = .T.
  684.             EXIT
  685.         ENDIF
  686.     ENDFOR
  687.     SELECT (nOld)
  688. RETURN lRet
  689. ********************************
  690.  
  691. *** END BUSINESS.PRG *******************************************************
  692.  
  693.